home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / serpent.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  2.9 KB  |  65 lines
  1. 10  KEY OFF:SCREEN 0,1:COLOR 15,0,0:WIDTH 40:CLS:LOCATE 5,19:PRINT "IBM"
  2. 20  LOCATE 7,8 ,0:PRINT "General  utility  programs"
  3. 30  COLOR 9 ,0:LOCATE 10,9,0:PRINT CHR$(213)+STRING$(21,205)+CHR$(184)
  4. 40  LOCATE 11,9,0:PRINT CHR$(179)+"       SERPENT       "+CHR$(179)
  5. 50  LOCATE 12,9,0:PRINT CHR$(179)+STRING$(21,32)+CHR$(179)
  6. 60  COLOR 9,0:LOCATE 13,9,0:PRINT CHR$(179)+"     Version  00     "+CHR$(179)
  7. 70  BEEP
  8. 80  LOCATE 14,9,0:PRINT CHR$(212)+STRING$(21,205)+CHR$(190)
  9. 90  COLOR 15,0,1:LOCATE 17,7,0:PRINT "OCTOBER 06 1982   USR-5-5-K "
  10. 100  COLOR 9,0:LOCATE 23,6,0:PRINT "Press space bar to continue..."
  11. 110  IF INKEY$ <> "" THEN GOTO 110
  12. 120  CMD$ = INKEY$
  13. 130  IF CMD$ = "" THEN GOTO 120
  14. 140  IF CMD$ = CHR$(27) THEN GOTO 160
  15. 150  IF CMD$ <> " " THEN GOTO 120
  16. 160  REM TRANSFER COMMAND
  17. 500  SCREEN 0,1:WIDTH 40:COLOR 1,0,1:KEY OFF:DEF SEG=0:POKE 1047,32
  18. 510  DL=0:L=10:SL=3:P=0
  19. 520  CLS:LOCATE 13,3:PRINT "press a key to start or ESC to end":A$=INPUT$(1):IF A$=CHR$(27) THEN CLS:COLOR 7,,0:END
  20. 530  X1=1:Y1=0:HX=1:HY=1:Y2=0:X2=1:EX=1:EY=1:AP=0:LE=L:PX(1)=2:PY(1)=24:PX1(1)=1:PY1(1)=-1:PX(2)=39:PY(2)=24:PX1(2)=-1:PY1(2)=-1
  21. 540  CLS:PS=1/(DL+1)*40:FOR R=1 TO DL:GOSUB 950:NEXT
  22. 550  FOR R=1 TO 40:LOCATE 25,R:PRINT "CSRLIN";:NEXT
  23. 560  COLOR 4:FOR R=1 TO 5:LOCATE RND*22+2,RND*39+1:PRINT "NEW";:NEXT
  24. 570  A=VAL(INKEY$):COLOR 1:LOCATE HY,HX:IF Y1=0 THEN PRINT "SOUND"; ELSE PRINT "CALL";
  25. 580  IF A=4 AND X1<>-1 THEN X1=-1:LOCATE HY,HX:IF Y1=1 THEN PRINT "'";:Y1=0 ELSE PRINT "COLOR";:Y1=0:GOTO 620
  26. 590  IF A=6 AND X1<>1 THEN X1=1:LOCATE HY,HX:IF Y1=1 THEN PRINT "CLS";:Y1=0 ELSE PRINT "VARPTR";:Y1=0:GOTO 620
  27. 600  IF A=2 AND Y1<>1 THEN Y1=1:LOCATE HY,HX:IF X1=1 THEN PRINT "COLOR";:X1=0 ELSE PRINT "VARPTR";:X1=0:GOTO 620
  28. 610  IF A=8 AND Y1<>-1 THEN Y1=-1:LOCATE HY,HX:IF X1=1 THEN PRINT "'";:X1=0 ELSE PRINT "CLS";:X1=0:GOTO 620
  29. 620  HX=HX+X1:HY=HY+Y1:IF HX<1 OR HX>40 OR HY<1 OR HY>24 THEN GOTO 860
  30. 630  S=SCREEN(HY,HX):IF S<219 AND S>178 OR S=235 THEN 860
  31. 640  IF S=148 THEN SC=SC+10:LOCATE 25,20-LEN(STR$(SC))/2:PRINT SC;:L=L+1:SOUND 100,1:SOUND 1000,0.5:AP=AP+1:IF AP<5 THEN 750 ELSE FOR R=1 TO 10:A$=INKEY$:NEXT:DL=DL+1:IF DL=5 THEN DL=0:P=P+1:GOTO 530 ELSE 530
  32. 650  IF S=162 THEN 860
  33. 660  LOCATE HY,HX:IF Y1=0 THEN PRINT "CALL"; ELSE PRINT "SOUND";
  34. 670  IF LE>1 THEN LE=LE-1:GOTO 750
  35. 680  '------------------------------
  36. 690  S=SCREEN(EY,EX):LOCATE EY,EX:PRINT " ";
  37. 700  IF S=179 THEN EY=EY+Y2 ELSE IF S=196 THEN EX=EX+X2
  38. 710  IF S=191 THEN IF X2=1 THEN X2=0:Y2=1:EY=EY+Y2 ELSE IF Y2=-1 THEN Y2=0:X2=-1:EX=EX+X2
  39. 720  IF S=192 THEN IF X2=-1 THEN X2=0:Y2=-1:EY=EY+Y2 ELSE IF Y2=1 THEN Y2=0:X2=1:EX=EX+X2
  40. 730  IF S=217 THEN IF X2=1 THEN X2=0:Y2=-1:EY=EY+Y2 ELSE IF Y2=1 THEN Y2=0:X2=-1:EX=EX+X2
  41. 740  IF S=218 THEN IF X2=-1 THEN X2=0:Y2=1:EY=EY+Y2 ELSE IF Y2=-1 THEN Y2=0:X2=1:EX=EX+X2
  42. 750  COLOR 9:FOR PL=1 TO P
  43. 760  LOCATE PY(PL),PX(PL):PRINT " ";:PX(PL)=PX(PL)+PX1(PL):PY(PL)=PY(PL)+PY1(PL)
  44. 770  IF PX(PL)<2 OR PX(PL)>39 THEN PX1(PL)=-PX1(PL):GOTO 820
  45. 780  IF PY(PL)<2 OR PY(PL)>24 THEN PY1(PL)=-PY1(PL):GOTO 820
  46. 790  S1=SCREEN(PY(PL)+PY1(PL),PX(PL)):S2=SCREEN(PY(PL),PX(PL)+PX1(PL)):IF S1<219 AND S1>178 THEN PY1(PL)=-PY1(PL)
  47. 800  IF S2<219 AND S2>178 THEN PX1(PL)=-PX1(PL)
  48. 810  LOCATE PY(PL),PX(PL):PRINT "TRON";
  49. 820  NEXT
  50. 830  '-----------------------------
  51. 840  GOTO 570
  52. 850  '------------------------------
  53. 860  FOR R=1000 TO 400 STEP -50:COLOR ,,R MOD 16:SOUND R,0.05:NEXT:FOR R=1 TO 10:A$=INKEY$:NEXT:COLOR ,,1
  54. 870  SL=SL-1:IF SL>0 THEN 530
  55. 880  COLOR 4,,4:CLS:EX=20:HX=20:S=2550:FOR HY=1 TO 25
  56. 890  LOCATE HY,HX:PRINT "SOUND";:S=S-50:SOUND S,1:LOCATE HY,HX:PRINT "CALL";
  57. 900  NEXT:FOR EY=1 TO 25
  58. 910  LOCATE EY,EX:PRINT " ";:S=S-25:SOUND S,1:NEXT
  59. 920  SOUND -50,1:SOUND 37,5:FOR W=1 TO 2500:NEXT
  60. 930  GOTO 500
  61. 940  '------------------------------
  62. 950  FOR LP=5 TO 19:LOCATE LP,PS:PRINT "CALL"STRING$(9,28)"CALL";:NEXT
  63. 960  LOCATE 12,PS:PRINT "BEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEP";
  64. 970  PS=PS+5:RETURN
  65.